
;;;
;;; maps.lisp

(in-package :dreaming-tree)

(defclass map (node)
  ((width :accessor map-width :initarg :width :initform 100.0)
   (height :accessor map-height :initarg :height :initform 100.0)
   (gsub :accessor grid-subdivision :initarg :subdivision :initform 10)
   (gshape :accessor grid-shape :initarg :shape :initform :square)
   (tdata :accessor terrain-data :initarg :terrain-data :initform nil)
   (hmap :accessor height-map :initarg :height-map :initform nil)))

(defclass terrain-map ()
  ((terrain :accessor terrain :initarg :terrain)
   (terrain-defs :accessor terrain-defs :initarg :terrain-defs)))

(defparameter *terrain-color-defs*
  '((grassland . #(.5 .98 .5))
    (forest . #(.710 .824 .612))
    (water . #(.600 .702 .800))))

(defparameter *grid-line-width* 0.13)

(defun new-grid-square (pos width height type name)
  (let ((square (make-instance 'rectangle :width (- width (* 2 *grid-line-width*))
			       :height (- height (* 2 *grid-line-width*))
			       :colors (cdr (assoc type *terrain-color-defs*))
			       :name name)))
    (set-position square pos)
    square))

(defun rebuild-map-grid (map)
  (setf (children map) nil)
  (with-slots (width height gsub gshape) map
    (let ((dx (/ gsub width))
	  (dy (/ gsub height)))
      (iter (for x below (floor (/ width gsub)))
	    (iter (for y below (floor (/ height gsub)))
		  (attach (new-grid-square (vector x y 0.0) dx dy 
					   (aref (terrain-data map) x y)
					   (format nil "GRID(~A,~A)" x y))
			  map)))))
  map)

(defun test-map-scene ()
  (rebuild-map-grid (make-instance 'map :width 2.0 :height 2.0 :subdivision 1.0)))

(defun random-map (grid-size)
  (let* ((width (* grid-size 1.0))
	 (height (* grid-size 1.0))
	 (map (make-instance 'map :width width :height height :subdivision 1.0 :terrain-data (make-array (list grid-size grid-size)))))
    (iter (for i below grid-size)
	  (iter (for j below grid-size)
		(setf (aref (terrain-data map) i j) (nth (random 3) '(grassland forest water)))))
    map))
